perm filename NTSB.OLD[XX,LCS] blob
sn#230612 filedate 1976-08-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE NOTWRT
C00038 ENDMK
C⊗;
TITLE NOTWRT
ENTRY NOTWRT
EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.,MAKNUM
EXTERNAL NTS,EXTRA,REST,ALPHA,DRWNT,FONT,BREP,FERMTA
EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW,AMOD,RJBX
%TEMP.: 0
DEFINE R3< .COMM.+4 >↔DEFINE R4< .COMM.+5 >↔DEFINE R5< .COMM.+6 >
DEFINE R6< .COMM.+7 >↔DEFINE R7< .COMM.+=8 >↔DEFINE J3< .COMM.+=24 >
DEFINE J4< .COMM.+=25 >↔DEFINE J5< .COMM.+=26 >↔DEFINE J6< .COMM.+=27 >
DEFINE J8< .COMM.+=29 >↔DEFINE R9< .COMM.+=10 >↔DEFINE R8< .COMM.+=9 >
DEFINE J2< .COMM.+3 >↔DEFINE J10< .COMM.+=31 >↔DEFINE J7< .COMM.+=28 >
DEFINE RMINI< ALF+=49 >↔DEFINE RINV< ALF+=50 >↔DEFINE RJZ< .COMM.+=23 >
DEFINE RA< ALF+=51 >↔DEFINE RX< ALF+=52 >↔DEFINE RJX< ALF+=53 >
DEFINE RJY< ALF+=54 >↔DEFINE RB< ALF+=55 >↔DEFINE RJW< ALF+=56 >
DEFINE RZ< ALF+=57 >↔DEFINE JX< ALF+=58 >↔DEFINE RG< ALF+=59 >
DEFINE KL< ALF+=60 >↔DEFINE RJAC< ALF+=61 >↔DEFINE K < ALF+=62 >
DEFINE L < ALF+=63 >↔DEFINE RQ< ALF+=64 >↔DEFINE RH< ALF+=65 >
DEFINE J5X< ALF+=66 >↔DEFINE RXX< ALF+=67 >↔DEFINE JJJ< ALF+=68 >
DEFINE JY< ALF+=70 >↔DEFINE RJ< ALF+=71 >↔DEFINE RSTJ2< STF+=8 >
DEFINE PLT< PLTR >↔DEFINE POS< POSI+=9 >↔DEFINE JA< .COMM.+1 >
DEFINE CENTR< .COMM.+2 >↔DEFINE RACNT< DAT >↔DEFINE RDOT< DAT+=65 >
DEFINE XAC< DAT+=82 >↔DEFINE RACCI< DAT+=111 >↔DEFINE NACCI< DAT+=133 >
DEFINE STEM < .COMM.+=43>
; 00010 C********** FOR NOTE DRAWING, RESTS ACCENT AND OTHER MARKS.
; 00100 SUBROUTINE NOTWRT
; 00200 IMPLICIT INTEGER(A-Q,S-Z)
; 00300 COMMON/DL/IXRX,M,AA /FONT/JFONT
;00600 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
; 00700 REAL DIS,CENTR,POS,STFF
; 00800 COMMON /STF/RSTFAC(-3/4),RSTJ2
; 00900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
; 01000 COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
;01110 C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
;01200 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
; 01300 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
; 01400 1 PUNCT,JY,RJ
;01500 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
;01600 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
;01700 1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(STEM,JQ(20))
;01800 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
; 01850 1,(RX4,JQ(19)),(J5X,RZTM)
NOTWRT: 0
; 04300 RSTX=RSTJ2
MOVE 02,RSTJ2
MOVEM 02,ALF+=48
; 04400 C FOR MINIS AT 245
; 04500 RMINI=RSTJ2
MOVEM 02,RMINI
; 04600 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
; 04100 RST7=7.*RSTJ2
FMPRI 02,203700
MOVEM 02,ALF+=46
; 04800 RINV=1
MOVSI 02,201400
MOVEM 02,RINV
; 04810 RX4=R4
MOVE 02,R4
MOVEM 02,.COMM.+=42
MOVE JA ; 04900 IF(JA.EQ.1)GO TO 11
CAIN 1
JRST A11
CAIN =9 ;05000 IF(JA.EQ.9)GO TO 242
JRST A242
; 05200 C NEXT IS FOR RESTS
MOVM J4 ; 05210 IF(IABS(J4).LT.480)GO TO 302
CAIGE 00,740
JRST A302
; 05220 C P4+500= USER-ADDED RESTS
; 05230 CALL EXTRA
JSA 16,EXTRA
; 05240 RETURN
JRA 16,(16)
A302: MOVE J5 ; 05300 302 IF(R8.NE.0.AND.J5.NE.-4)J5=-2
MOVE 02,R8 ;J5=-4 MAKES REPEAT BAR SIGN
JUMPE 02,.+5
CAMN [-4]
JRST .+3
MOVNI 2
MOVEM J5
; 05400 C R8 PUTS NUMBER OVER WHOLE REST ONLY.
; 05500 IF(J5.GT.1)R4=R4-2
CAIG 1
JRST .+3
MOVSI 02,575400
FADRM 02,R4
; 05700 R7=R6*10.
MOVSI 02,204500
FMPR 02,R6
MOVEM 02,R7
; 05800 C FOR DOTS
CAIGE 2 ; 05850 IF(J5.GE.2)R3=R3-3.0*RSTJ2
JRST .+5
MOVSI 02,202600
FMPR 02,RSTJ2
FSBRM 02,R3
MOVNS 00,R3
; 05875 C SHIFTS 1/16 AND SMALLER RESTS .5 TO LEFT
; 05900 202 CALL REST
A202: JSA 16,REST
; 06000 IF(J5.GT.1)GO TO 200
MOVEI 02,1
CAMGE 02,J5
JRST A200
SKIPN R7 ; 06100 IF(R7.EQ.0)RETURN
JRA 16,(16)
; 06200 201 RA=14
A201: MOVSI 02,204700
; 06300 R6=0
SETZM R6
SKIPGE J5 ; 06400 IF(J5)RA=19
MOVSI 02,205460
;; MOVEM 02,RA
; 06500 R3=R3+RA*RSTJ2
FMPR 02,RSTJ2
FADRM 02,R3
; 06600 R4=8.+R4
MOVSI 02,204400
FADRM 02,R4
; 06700 JA=9
MOVEI 02,11
MOVEM 02,JA
; 06800 J5=7
MOVEI 02,7
MOVEM 02,J5
; 06900 C IF P6=1 THE REST IS DOTTED
; 07000 CALL CENTX
JSA 16,CENTX
; 07100 GO TO 242
JRST A242
; 07200 200 J5=J5-1
A200: SOS J5
; 07300 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
; 07400 R4=R4+2.
MOVSI 02,202400
FADRM 02,R4
; 07500 CALL RJBX(4.3)
JSA 16,RJBX
JUMP 02,[4.3]
; 07600 GO TO 202
JRST A202
A29: MOVEM 02,RJX ; 07800 29 RJX=R3
; 07900 RJY=CENTR+RSTJ2
MOVE 02,RSTJ2
FADR 02,CENTR
MOVEM 02,RJY
; 08000 108 IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
A108: MOVE 02,WHOLE#
JUMPE 02,.+5
MOVSI 02,202600
FMPR 02,RMINI
FADRM 02,RJX
; 08100 C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
; 08200 WHOLE=0
SETZM WHOLE
; 08210 RG=9
MOVSI 02,204440
SKIPGE PLT ; 08220 IF(PLT)RG=17
MOVSI 2,205420
MOVEM 02,RG ; 08230 DOESN'T FILL DOT ON DPY
; 08300 107 CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
A107: JSA 16,RDRAW
JUMP 00,[1]
JUMP 02,RG
JUMP 02,RDOT
JUMP 02,RMINI
JUMP 02,RJX
JUMP 02,RJY
JUMP 02,RMINI
;08400 **** **** *** ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
; 08500 IF(JA.EQ.1)GO TO 290
MOVEI 02,1
CAMN 02,JA
JRST A290
; 08600 IF(R7.GE.20.)GO TO 290
MOVSI 02,205500
CAMG 02,R7
JRST A290
; 08700 RB=POS+52.*RSTJ2
MOVSI 02,206640
FMPR 02,RSTJ2
FADR 02,POS
MOVEM 02,RB
CAME 2,RJY ; 08800 IF(RJY.NE.RB)GO TO 6241
JRST A6241
; 08900 C WHERE IS RB USED LATER?
; 09000 RJY=RJY-12*RSTJ2
MOVSI 02,204600
FMPR 02,RSTJ2
FSBRM 02,RJY
MOVNS 00,RJY
; 09100 GO TO 107
JRST A107
; 09200 C ABOVE FOR DOTS
; 09300 290 R7=R7-10.
A290: MOVN 02,[10.0]
FADRB 02,R7
CAMGE 2,[10.0] ; 09400 IF(R7.LT.10.)GO TO 1342
JRST A1342
; 09500 RJX=RJX+RSTJ2*10.
MOVSI 02,204500
FMPR 02,RSTJ2
FADRM 02,RJX
; 09600 GO TO 107
JRST A107
; 10000 C NOTES****
; 10200 11 CALL NTS
A11: JSA 16,NTS
SKIPGE STEM ; 10300 IF(STEM)RETURN
JRA 16,(16)
; 10400 R4=RX4
MOVE 02,.COMM.+=42
MOVEM 02,R4
; 23500
; 31500 1242 IF(R7.LT.10.)GO TO 1342
A1242: MOVSI 02,204500
CAMLE 02,R7
JRST A1342
; 31600 C FOR DOTTED NOTE-- P7>9
; 31700 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
JSA 16,AMOD
JUMP 02,R7
JUMP 02,[1.0]
FMPR 00,[59.6]
FADRI 00,205540
FMPR 00,RMINI
FADR 00,RJAC
;; MOVEM 00,RJX
; 31800 C***↑↑↑↑↑ WAS 24. 11/74
MOVE 02,RSTJ2 ;31900 RJY=CENTR+RSTJ2
FADR 02,CENTR
MOVEM 02,RJY
MOVE 2,JY ; TO USE LATER
MOVSI 3,207620 ; IF(R7.LT.100)GO TO A12
CAMLE 3,R7
JRST A12 ; SAVE +100 OR -100 IN AC3
MOVNS 3 ; R7=R7-100
FADRM 3,R7 ;ADD 100 TO R7 TO PUT DOT BELOW NOTE.
CAIE 2,=20 ; SKIP NEXT IF JY=20 (NOTE TO LFT OF STEM)
FADR 0,[14.54] ; RJX=RJX+14.54
A12: CAIN 2,12 ;32000 IF(JY.EQ.10)RJX=RJX+14.54
FADR 0,[14.54] ;32200 4322 RJX=RJX+RSTM
MOVEM 0,RJX ; PUT AWAY RJX
;32300 C MOVES DOT TO LEFT
A3322: MOVE J4 ;32400 3322 IF(MOD(J4,2).EQ.0)GO TO 108
IDIVI 2
JUMPE 1,A108 ; 32500 RX=RST7
MOVE 02,ALF+=46
;;; MOVE JY ; 32600 IF(JY.GE.20)RX=-RX
SKIPGE 3 ; IF -100 RX=-RX
;; CAIL =20
MOVNS 2 ; ADD 100 TO R7 FOR DOTS BELOW! NOTE
FADRM 02,RJY ;32700 3342 RJY=RJY+RX
; 32800 GO TO 108
JRST A108 ; 33000 1342 IF(J5.NE.0)GO TO 5322
A1342: MOVE 02,J5
JUMPN 02,A5322
SKIPN R6 ; 33100 IF(R6.EQ.0)RETURN
JRA 16,(16)
; 33200 5322 R3=R3-R5*59.6*RMINI
A5322: MOVE 02,[59.6]
FMPR 02,R5
FMPR 02,RMINI
FSBRM 02,R3
MOVNS 00,R3
; 33300 C TO SPACE OUT ACCIDS.
; 33700 242 IF(J5.GE.0)GO TO 2421
A242: MOVE 02,J5
JUMPGE 02,A2421
; 33800 RINV=-RINV
MOVNS 00,RINV
; 33900 J5=-J5
MOVNS 00,J5
;34000 NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
; 34100 C********** LAST # WAS 281?
; 34200 C B,#,NAT, ACC ↑, ACC >, FERMATA, DOT, REP MEAS., DASH
; 34400 2421 J5X=-1
A2421: SETOM J5X
; 34500 JAX=JA
MOVE 02,JA
MOVEM 02,JAX#
; 34600 C USED AT 4241 FOR DOUBLE MARKS ON NOTES.
; 34700 IF(JA.EQ.9)GO TO 2423
MOVEI 02,11
CAMN 02,JA
JRST A2423
; 34800 IF(J5.GT.3)GO TO 3121
MOVE 1,J5
CAILE 1,3 ; AC1 IS USED AT A211!!!
JRST A3121
;34900 C DBL FLT(4) AND DBL SHRP(5) ALWAYS USE 'DRAW' ROUTINE.
JRST A211 ; 35000 GO TO 211
; 35100 2423 RJZ=R4
A2423: MOVE 02,R4
MOVEM 02,RJZ
; 35200 C FOR 'DRWNT' WHEN PLOTTING.
; 35300 CALL NOZERO(R6)
SKIPN 2,R6
MOVE 2,[1.0]
; 35400 C R6=SIZE FACTOR (P6)
; 35500 RMINI=RMINI*R6
FMPRM 02,RMINI
; 35600 R6=0
SETZM R6
; 35700 STEM=0
SETZM STEM
; 35800 C FOR MISC. ITEMS
A210: MOVM J4 ; 35900 210 IF(IABS(J4).LT.100)GO TO 1241
CAIGE 00,144
JRST A1241
MOVE J4 ; 36100 J4=MOD(J4,100)
IDIVI =100
MOVEM 1,J4
; 36200 RMINI=.7*RMINI
MOVE 02,[0.7]
FMPRM 02,RMINI
; 36400 C FOR 2 MARKS AT ONCE.
A1241: MOVE J5 ; 36500 1241 IF(J5.GE.11)GO TO 28
CAIL 13
JRST A28
; 36600 GO TO (211,211,211,28,28,222,249,60,27,27),J5
SKIPLE 01,J5
CAILE 01,12
SKIPA 0
M13: JRST @M13 (1)
JUMP 00,A211
JUMP 00,A211
JUMP 00,A211
JUMP 00,A28
JUMP 00,A28
JUMP 00,A222
JUMP 00,A249
JUMP 00,A60
JUMP 00,A27
JUMP 00,A27
; 36700 RETURN
JRA 16,(16)
; 36800 C ERROR TRAP (I.E. J5=0)
; 36900 C FOR 1 OR 2 BAR REP SIGNS.
; 37000 60 CALL BREP
A60: JSA 16,BREP
; 37100 RETURN
JRA 16,(16)
; 37300 241 CALL LINES(R3,CENTR,3)
A241: JSA 16,LINES
JUMP 02,R3
JUMP 02,CENTR
JUMP 00,[3]
; 37400 GO TO 210
JRST A210
; 37700 211 IF(J5.EQ.0)GO TO 2422
;;;A211: MOVE 02,J5
A211: JUMPE 1,A2422
; 37800 C GETS BACK GOOD VERTICAL POS.
CAILE 1,3 ; 37900 IF(J5.GT.3)GO TO 222
JRST A222
; 38000 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
; 38100 IF(PLT)GO TO 3121
MOVE 02,PLT
JUMPL 02,A3121
; 38200 IF(JFONT.NE.0)GO TO 3121
MOVE 02,FONT
JUMPN 02,A3121
; 38300 X=NACCI(J5)
;; MOVE 03,J5
MOVE 02,NACCI -1(1)
;;; MOVEM 02,X
;38400 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
;;; MOVEI 02,1
;;; ADD 02,X
AOJ 2,
MOVEM 02,%TEMP.
;;; MOVE 04,X
;;; MOVEI 03,RACCI -1(4)
MOVEI 03,RACCI -2(2)
HRRM 03,AA14
JSA 16,RDRAW
JUMP 00,%TEMP.
AA14: JUMP 02,AA14
JUMP 02,RACCI
JUMP 02,RMINI
JUMP 02,R3
JUMP 02,CENTR
JUMP 02,RMINI
; 38500 2422 IF(R6.EQ.0)RETURN
A2422: SKIPN 2,R6
JRA 16,(16)
CAMGE 2,[0.1] ;IF(R6.LT..1)RETURN 4/76
JRA 16,(16) ;SO UP TO .0099 CAN BE PUT IN P6 FOR 'EXTRA'
; 38600 J5=(R6+.001)*100.
MOVE 02,[0.001]
FADR 02,R6
FMPRI 02,207620
KIFIX 0,2 ; JSA 16,IFIX
; JUMP 00,2
MOVEM 00,J5
; 38700 R4=RX4
MOVE 02,.COMM.+=42
MOVEM 02,R4
; 38900 R3=RJAC
MOVE 02,RJAC
MOVEM 02,R3
A1249: MOVE J5 ; 39000 1249 IF(MOD(J5,10).GT.3)GO TO 249
IDIVI 12
CAILE 1,3
JRST A249
; 39100 J5=J5/10
MOVEM 0,J5
CAIL =40 ;39200 IF(J5.GT.39)GO TO 1249
JRST A1249
; 39300 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
; 39400 249 IF(J5.GT.30)GO TO 28
A249: MOVE J5
CAILE 36
JRST A28
CAILE 12 ; 39500 IF(J5.GT.10)GO TO 246
JRST A246
SKIPN J5 ; 39600 IF(J5.EQ.0)RETURN
JRA 16,(16)
; 39700 IF(JA.NE.1)GO TO 250
MOVEI 02,1
CAME 02,JA
JRST A250
; 39900 RB=14.
MOVSI 02,204700
MOVEM 02,RB
MOVE 1,J4 ; 40000 IF(MOD(J4,2).EQ.0)GO TO 244
IDIVI 1,2
JUMPE 2,A244
CAIN 7 ; 40100 IF(J5.EQ.7)GO TO 6322
JRST A6322
CAIE =9 ; 40200 IF(J5.NE.9)GO TO 244
JRST A244
A6322: MOVE 3,J4 ; 40300 6322 IF(STEM.GT.1)GO TO 7322
MOVE 1,STEM
CAILE 1,1
JRST A7322
; 40400 IF(J4.LT.5)GO TO 244
CAIGE 3,5
JRST A244
A7322: CAIG 3,=9 ;40500 7322 IF(J4.LE.9)GO TO 8322
JRST A8322
CAIN 1,2 ; 40600 IF(STEM.EQ.2)GO TO 244
JRST A244
JUMPE 1,A244 ; 40700 IF(STEM.EQ.0)GO TO 244
; 40800 8322 RB=21
A8322: MOVSI 02,205520
MOVEM 02,RB
;40900 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
A244: MOVE 2,STEM ; 41000 244 IF(STEM.EQ.1)GO TO 9322
CAIN 2,1
JRST A9322
JUMPN 2,A245 ; 41100 IF(STEM.NE.0)GO TO 245
; 41200 IF(J4.GE.7)GO TO 245
MOVEI 02,7
CAMG 02,J4
JRST A245
; 41300 9322 RB=-RB
A9322: MOVNS 00,RB
; 41700 245 CENTR=CENTR+RB*RSTX
A245: MOVE 02,ALF+=48
FMPR 02,RB
FADRM 02,CENTR
A250: CAILE 12 ;41800 250 IF(J5.GT.10)GO TO 281
JRST A281
CAIGE 6 ; 41900 IF(J5.LT.6)GO TO 281
JRST A281
; 42000 JA=9
MOVEI 02,11
MOVEM 02,JA
CAIE 7 ; 42100 IF(J5.NE.7)GO TO 253
JRST A253
; 42200 C 7=DOT
; 42300 RXX=R3
MOVE 02,R3
MOVEM 02,RXX
; 42400 R3=R3+6.7*RMINI
MOVE 02,[6.7]
FMPR 02,RMINI
FADRB 02,R3
; 42500 C CENTERS THE DOT
; 42600 GO TO 29
JRST A29
A253: CAIN 11 ; 42700 253 IF(J5.EQ.9)GO TO 271
JRST A271
; 42800 C 9=DASH
; 42900 251 IF(RB.LT.0)RINV=-RINV
A251: SKIPGE RB
; 43000 C FIX THIS!!!! FOR BOWINGS, ETC.
A2222: CAIE 24 ; 43100 2222 IF(J5.NE.20)GO TO 2223
JRST A2223
; 43300 JA=7
MOVEI 02,7
MOVEM 02,JA
; 43400 R5=0
SETZM R5
; 43500 J7=1
MOVEI 02,1
MOVEM 02,J7
; 43600 CALL ALPHA
JSA 16,ALPHA
; 43700 C FOR TRILL -- J5=20
JRA 16,(16)
A2223: CAIN 21 ; 43900 2223 IF(J5.EQ.17)GO TO 323
JRST A323
CAIE 22 ; 44000 IF(J5.NE.18)GO TO 222
JRST A222
; 44100 323 RINV=J5
A323: FLTR 0,0 ;TLC 0,232000 FLOAT IT.
;FADR 0,0
MOVEM 0,RINV
; 44200 C FOR MORD, INV.MORD
; 44300 222 CALL FERMTA
A222: JSA 16,FERMTA
; 44400 GO TO 5241
JRST A5241
A246: CAIGE 12 ; 44800 246 IF(J5.LT.10)GO TO 245
JRST A245
; 45020 RZ=3
MOVSI 02,202600
; 45040 IF(STEM.EQ.1)RZ=9+R8
MOVEI 3,1
CAME 3,STEM
JRST .+3
MOVSI 02,204440
FADR 02,R8
;;;;;; MOVEM 02,RZ
; 45060 R4=R4+RZ*RMINI/RSTJ2
FMPR 02,RMINI
FDVR 02,RSTJ2
FADRB 02,R4
CAML 2,[12.5] ; 45100 IF(R4.LT.12.5)R4=12.5
JRST .+3
MOVSI 02,204620
MOVEM 02,R4
; 45200 CALL CENTX
JSA 16,CENTX
MOVE J5 ; 45300 IF(J5.EQ.26)GO TO 222
CAIN 32
JRST A222
; 45400 C 26 IS NEW NUMB FOR FERMATA.
A28: CAIGE =30 ; 45500 28 IF(J5.LT.30)GO TO 281
JRST A281 ; PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
CAIL =36 ;IF(J5.GE.36)GO TO A28X
JRST A28X
SUBI =30 ;R5=J5-30 GET THE 1 DIGIT NUM.
FLTR ; FLOAT IT
MOVEM .COMM.+6 ; R5
MOVE [0.7] ;0.7
MOVEM .COMM.+7 ; R6=.75 SIZE OF NUM.
MOVSI 0,203600 ;GET 6.0
MOVEI 2,2
CAME 2,STEM ;IF(STEM.EQ.1) SHIFT 2 TO RIGHT
FADR 0,[2.0]
FMPR 0,STF+=8 ;* RSTJ2
KIFIX ;FIXIT
ADDM .COMM.+30 ;JX3=JX3+RSTJ2*6.0 GET REAL R3 BACK,PUSH LEFT.
SETZM .COMM.+=8 ;R7=0
SETZM .COMM.+=9 ;R8=0
SETZM .COMM.+=10 ;R9=0
MOVSI 202500 ;RA=2.5
MOVEI 2,1 ;IF(STEM.EQ.2)RA=-RA
CAME 2,STEM
JRST .+3
MOVNS
FSBR [1.5]
FLTR 2,.COMM.+=25 ; GET J4 (R4 AND RX4 GET CHANGED IN TAILS)
FADR 2 ;R4=J4+RA HGT OF NUM.
MOVEM .COMM.+5
JSA 16,MAKNUM ;CALL MAKNUM(R5)
JUMP .COMM.+6
JRA 16,(16) ;ADD HERE FOR NUMS WITH ACCENTS, ETC.
A28X: IDIVI 12 ; 45600 J5X=MOD(J5,10)
MOVEM 1,J5X
; 45700 C J5X SAVES NEXT MARK.
CAIGE 1,4 ; 45800 IF(J5X.LT.4)J5X=0
SETZM J5X
; 45900 J5=J5/10
MOVEM 0,J5
CAILE =30 ; 46000 IF(J5.GT.30)RETURN
JRA 16,(16)
; 46100 C WON'T READ 415 ETC. (CORRECT=154)
; 46200 C DOES BOTTOM MARK FIRST, THEN TOP.
; 46300 CALL EXCH(J5X,J5)
EXCH J5X
MOVEM J5
; 46400 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
; 46500 IF(JA.EQ.1)GO TO 249
MOVEI 02,1
CAMN 02,JA
JRST A249
; 46600 GO TO 1241
JRST A1241
; 46700 281 X=1
A281: MOVEI 02,1
MOVEM 02,X#
CAILE =16 ; 46800 IF(J5.GT.16)GO TO 2222
JRST A2222
; 46900 C JUMP FOR MORD, INV.MORD, TRILL
CAIE 4 ; 47000 IF(J5.NE.4)GO TO 228
JRST A228
; 47100 X=5
MOVEI 02,5
MOVEM 02,X
; 47200 CALL RJBX(.5)
JSA 16,RJBX
JUMP 02,[0.5]
; 47300 GO TO 328
JRST A328
; 47400 228 IF(J5.GT.10)X=XAC(J5-10)
A228: CAIG 12
JRST .+4
MOVE 03,J5
MOVE 02,XAC -13(3)
MOVEM 02,X
; 47500 C X IS POINTER IN RACNT ARRAY
; 47600 328 RA=RMINI
A328: MOVE 02,RMINI
MOVEM 02,RA
; 47700 C OR RSTJ2?
; 47800 IF(RINV.LT.0)GO TO 1323
MOVE 02,RINV
JUMPL 02,A1323
; 47900 IF(STEM.NE.1)GO TO 2323
MOVEI 02,1
CAME 02,STEM
JRST A2323
CAIE 4 ; 48000 IF(J5.NE.4)GO TO 2323
JRST A2323
; 48100 1323 RA=-RA
A1323: MOVNS 00,RA
; 48200 C ↑↑↑ X ↑↑↑ PICKS UP TYPO ERRORS
;48300 2323 IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
A2323: MOVEI 02,66
CAMG 02,X
JRST A5241
MOVEI 02,1
ADD 02,X
MOVEM 02,%TEMP.
MOVE 04,X
MOVEI 03,RACNT -1(4)
HRRM 03,AA24
JSA 16,RDRAW
JUMP 00,%TEMP.
AA24: JUMP 02,AA24
JUMP 02,RACNT
JUMP 02,RA
JUMP 02,R3
JUMP 02,CENTR
JUMP 02,RMINI
;48400 PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
;48500 IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
; 48600 GO TO 5241
JRST A5241
; 48700 4241 JJJ=J5
A4241: MOVE 1,J5
MOVEM 1,JJJ
; 48800 J5=J5X
MOVE J5X
MOVEM J5
; 48900 J5X=-1
SETOM J5X
; 49000 IF(JAX.NE.1)GO TO 7241
MOVEI 02,1
CAME 02,JAX
JRST A7241
CAILE 12 ; 49100 IF(J5.GT.10)GO TO 246
JRST A246
CAIE 7 ; 49200 IF(J5.NE.7)GO TO 7241
JRST A7241
CAIE 1,=9 ; 49300 IF(JJJ.NE.9)GO TO 249
JRST A249
; 49400 7241 RXX=8.5*RMINI
A7241: MOVSI 02,204420
FMPR 02,RMINI
MOVEM 02,RXX
; 49500 C↑↑↑↑↑↑ 11/74 WAS RH*
; 49600 IF(STEM.EQ.1)RXX=-RXX
MOVEI 02,1
CAMN 02,STEM
MOVNS 00,RXX
; 49700 CENTR=CENTR+RXX
MOVE 02,RXX
FADRM 02,CENTR
CAIE 32 ; 49800 IF(J5.EQ.26)J5=6
JRST A1241
MOVEI 02,6
MOVEM 02,J5
; 49900 C TEMPORARY?? FIX
; 50000 GO TO 1241
JRST A1241
; 50100 C >=5, ↑=4
; 50200 27 R3=J3
A27: FLTR 2,J3 ;MOVE 2,J3
; TLC 2,232000
; FADR 2,2
MOVEM 2,R3 ; 50300 C DASHES
; 50400 271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
A271: MOVSI 02,204700
FMPR 02,RMINI
FADR 02,R3
MOVEM 02,%TEMP.
JSA 16,LINX
JUMP 02,R3
JUMP 02,CENTR
JUMP 02,%TEMP.
JUMP 02,CENTR
;50500 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
; 50600 5241 IF(J5X.GT.0)GO TO 4241
A5241: MOVE 02,J5X
JUMPG 02,A4241
; 50700 C J5X IS FOR DOUBLE MARKS. (WHAT ABOUT DOT POSITION.)
; 50800 RETURN
JRA 16,(16)
; 50900 6241 R3=RXX
A6241: MOVE 02,RXX
MOVEM 02,R3
; 51000 C RESET R3 AFTER A DOT.
; 51100 GO TO 5241
JRST A5241
; 51200 3121 J5=J5+9
A3121: MOVEI 02,11
ADDM 02,J5
; 51300 C SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
;51400 C TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
; 51500 CALL DRWNT
JSA 16,DRWNT
; 51600 GO TO 2422
JRST A2422
END ; 51700 END